home *** CD-ROM | disk | FTP | other *** search
/ Skunkware 98 / Skunkware 98.iso / src / interp / tclStruct1.2.tar.gz / tclStruct1.2.tar / tclStruct1.2 / stAccess.c < prev    next >
C/C++ Source or Header  |  1995-10-17  |  12KB  |  399 lines

  1. /*
  2.  *    tclStruct package
  3.  *  Support 'C' structures in Tcl
  4.  *
  5.  *  Written by Matthew Costello
  6.  *  (c) 1995 AT&T Global Information Solutions, Dayton Ohio USA
  7.  *
  8.  *  See the file "license.terms" for information on usage and
  9.  *  redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  10.  */
  11. #include "stInternal.h"
  12. STRUCT_SCCSID("@(#)tclStruct:stAccess.c    1.3    95/10/17")
  13.  
  14.  
  15. /*
  16.  * Struct_GetObject
  17.  *    get the object from its name
  18.  *
  19.  *  Side Effects:
  20.  *    The object type is attached
  21.  *
  22.  */
  23. int
  24. Struct_GetObject(interp,name,po) 
  25.   Tcl_Interp *interp;            /* Current interpreter. */
  26.   CONST char *name;
  27.   Struct_Object *po;
  28. {
  29.     Struct_Object *object;
  30.     char *s,*y;
  31.     CONST char *err;
  32.  
  33. #ifdef DEBUG
  34.     if (struct_debug & (DBG_GETOBJECT))
  35.     printf("Struct_GetObject( %s )\n", name ? name : "<null>" );
  36. #endif
  37.     po->type = NULL;
  38.  
  39.     /*  Is this a bona-fide object?   Note that this object
  40.      *  could be an array reference.  Normally the chopping
  41.      *  up of a name is done internally (to Tcl) in
  42.      *  tclVar.c:LookupVar(), so we need to duplicate that
  43.      *  logic here.
  44.      */
  45.     if ((s = strchr( name, '(' )) != NULL)
  46.     *s = '\0';
  47.     object = (Struct_Object *)STRUCT_GETOBJECT(interp,(char *)name);
  48.     if (s != NULL)
  49.     *s++ = '(';
  50.     if (object != NULL) {
  51.     Struct_CheckObject(object,"GetObject");
  52.  
  53.     if (s != NULL) {
  54.         y = strchr( s, '\0' );
  55.         if (*--y != ')') {
  56. #ifdef DEBUG
  57.         if (struct_debug & (DBG_GETOBJECT))
  58.         printf("Struct_GetObject( %s ) = NULL (badly formed!)\n",
  59.             name );
  60. #endif
  61.         Tcl_AppendResult(interp,"badly formed object access",NULL);
  62.         return TCL_ERROR;
  63.         }
  64.         *y = '\0';
  65.         *po = *object;
  66.         Struct_AttachType(po->type);
  67.         err = Struct_AccessElement(interp,po,s);
  68.         *y = ')';
  69.         if (err != NULL) {
  70. #ifdef DEBUG
  71.         if (struct_debug & (DBG_GETOBJECT))
  72.         printf("Struct_GetObject( %s ) = NULL (AE = %s!)\n",
  73.             name, err );
  74. #endif
  75.         Tcl_SetResult(interp,(char *)err,NULL);
  76.         return TCL_ERROR;
  77.         }
  78. #ifdef DEBUG
  79.         if (struct_debug & (DBG_GETOBJECT))
  80.         printf("Struct_GetObject( %s ) = %s\n",
  81.             name, Struct_ObjectName(object,1) );
  82. #endif
  83.         return TCL_OK;
  84.     } else {
  85.         /*  Set the object and attach its type.  */
  86.         *po = *object;
  87.         Struct_AttachType(po->type);
  88. #ifdef DEBUG
  89.         if (struct_debug & (DBG_GETOBJECT))
  90.         printf("Struct_GetObject( %s ) = %s\n",
  91.             name, Struct_ObjectName(object,1) );
  92. #endif
  93.         return TCL_OK;
  94.     }
  95.     }
  96.  
  97.     /*  Do we have a specially formatted address pointer:
  98.      *        type#address
  99.      *  This is complicated by the fact that we cannot lookup
  100.      *  a type name unless we have access to the hash table.
  101.      */
  102.     if ( ((s = strchr( name, '#' )) != NULL) &&
  103.      ((po->data = (void *)strtol( s+1, &y, 10 )) != NULL) &&
  104.          (*y == '\0') ) {
  105.     /* This could be it.  Find the type hash table. */
  106.     ClientData cdata;
  107.     if ((cdata = Struct_GetClientData(interp)) == NULL) {
  108. #ifdef DEBUG
  109.         if (struct_debug & (DBG_GETOBJECT))
  110.         printf("Struct_GetObject( %s ) = NULL (no hash table!)\n", name );
  111. #endif
  112.         Tcl_AppendResult(interp,"cannot find tclStruct type table");
  113.         return TCL_ERROR;
  114.     }
  115.     /*  Try to look up the type.  */
  116.     *s = '\0';
  117.     po->type = Struct_LookupType(cdata,interp,name);
  118.     *s = '#';
  119.     if (po->type == NULL) {
  120. #ifdef DEBUG
  121.         if (struct_debug & (DBG_GETOBJECT))
  122.         printf("Struct_GetObject( %s ) = NULL (unknown type!)\n", name );
  123. #endif
  124.         return TCL_ERROR;
  125.     }
  126.     po->size = po->type->size;
  127. #ifdef DEBUG
  128.         if (struct_debug & (DBG_GETOBJECT))
  129.     printf("Struct_GetObject( %s ) = %s\n",
  130.         name, Struct_ObjectName(po,0) );
  131. #endif
  132.     return TCL_OK;
  133.     }
  134.  
  135.  
  136. #ifdef DEBUG
  137.     if (struct_debug & (DBG_GETOBJECT))
  138.     printf("Struct_GetObject( %s ) = NULL (not an object!)\n", name );
  139. #endif
  140.     Tcl_AppendResult(interp,"\"", name,"\" is not an object",NULL);
  141.     return TCL_ERROR;
  142. }
  143.  
  144. /*
  145.  * get the object & check type
  146.  *
  147.  *  Side Effects:
  148.  *    does NOT attach the type
  149.  */
  150. int
  151. Struct_GetObjectAndCheck(interp,name,type,object) 
  152.   Tcl_Interp *interp;            /* Current interpreter. */
  153.   CONST char *name;
  154.   CONST char *type;
  155.   Struct_Object *object;
  156. {
  157.  
  158.     if (Struct_GetObject(interp,name,object) == TCL_ERROR)
  159.     return TCL_ERROR;
  160.     if (object->type->name == NULL) {
  161.     Tcl_AppendResult(interp,"\"", name,"\" is"
  162.         " not of expected type ",type, (char *) NULL);
  163.     Struct_ReleaseType(object->type);
  164.     return TCL_ERROR;
  165.     } else if (strcmp(object->type->name,type) != 0) {
  166.     Tcl_AppendResult(interp,"\"", name,"\" is of type ",
  167.         object->type->name,
  168.         " and not of expected type ",type, (char *) NULL);
  169.     Struct_ReleaseType(object->type);
  170.     return TCL_ERROR;
  171.     }
  172.     Struct_ReleaseType(object->type);
  173.     return TCL_OK;
  174. }
  175.  
  176. /*
  177.  * Figure out what part of the object is to be accessed, and
  178.  * its underlying type.  Because this routine is generally
  179.  * called from a trace, it needs to return any error message
  180.  * directly to the caller.
  181.  */
  182. CONST char *
  183. Struct_AccessElement(interp,object,name2)
  184.   Tcl_Interp *interp;
  185.   Struct_Object *object;    /* I/O 'partial' object */
  186.   char *name2;
  187. {
  188.     char *s;
  189.     Struct_StructElem *pelem;
  190.     char namebuf[256];
  191.     static char errbuf[256];
  192. #ifdef DEBUG
  193.     if (struct_debug & (DBG_PARSEELEMENT))
  194.     printf("Struct_AccessElement( obj = %s, name2 = %s )\n",
  195.     Struct_ObjectName(object,0),
  196.     (name2 == NULL) ? "<null>" :
  197.       (*name2 == '\0') ? "<empty>" : name2 );
  198. #ifdef TCL_MEM_DEBUG
  199.     Tcl_ValidateAllMemory(__FILE__,__LINE__);
  200. #endif
  201. #endif
  202.     if (name2 == NULL || *name2 == '\0') {
  203.     return NULL;    /* OKAY */
  204.     }
  205.     if (strchr(name2,'.') != NULL || *name2 == '_') {
  206.     strcpy( namebuf, name2 );
  207.     name2 = namebuf;
  208.     }
  209. #ifdef lint
  210.     s = NULL;    /* Damm those lint bugs anyway! */
  211. #endif
  212.     for ( ; name2 != NULL ; name2 = s ) {
  213.     if ((s = strchr( name2, '.' )) != NULL) {
  214.         *s++ = '\0';
  215.     }
  216.  
  217. #ifdef DEBUG
  218.     if (struct_debug & (DBG_PARSEELEMENT))
  219.         printf("Struct_AccessElement: obj = %s, elem = %s\n",
  220.         Struct_ObjectName(object,0),
  221.         name2 ? name2 : "<null>" );
  222. #endif
  223.     /*  Element names beginning and ending with '_' are
  224.      *  reserved for type overrides.
  225.      */
  226.     if (name2[0] == '_' && name2[strlen(name2)-1] == '_') {
  227.         /*  We need to find out where the typedef hash table is. */
  228.         ClientData cdata;
  229.         if ((cdata = Struct_GetClientData(interp)) == NULL)
  230.         return "No access to type table";
  231.         /* Convert to just the type name. */
  232.         name2[strlen(name2)-1] = '\0';
  233.         /* Because we don't want the "_addr_" to lose the underlying
  234.          * type, we handle _addr_ specially by crafting a pointer
  235.          * with the Struct_TraceAddr() attached.
  236.          */
  237.         if (strcmp("addr", name2+1 ) == 0) {
  238.         Struct_TypeDef *oldtype = object->type;
  239.         object->type = Struct_NewType(cdata,interp,NULL,0,
  240.             STRUCT_FLAG_IS_ADDR,Struct_TraceAddr);
  241.         object->type->u.a.array_elem = oldtype;
  242.         continue;
  243.         }
  244.         /* Look it up. */
  245.         Struct_ReleaseType(object->type);
  246.         if ((object->type = Struct_LookupType(cdata,interp,name2+1)) == NULL) {
  247.         (void) strncpy( errbuf, interp->result, sizeof(errbuf)-1 );
  248.         return errbuf;
  249.         }
  250.         /* Verify that the sizes are compatible. This means that the
  251.          * sizes are either identical, or the new size is a multiple
  252.          * of the original.
  253.          */
  254.         if (object->size == object->type->size) {
  255.         /*EMPTY*/;
  256.         } else if (object->type->size == 0) {
  257.             /* Zero-length object */
  258.         return "object is of zero length";
  259.         } else if ( ((object->size % object->type->size) == 0) &&
  260.             (object->type->flags & STRUCT_FLAG_TRACE_ARRAY) ) {
  261.         /* Multiple.  Make it an array. */
  262.         Struct_TypeDef *oldtype = object->type;
  263.         object->type = Struct_DefArray( cdata, interp,
  264.             object->type,
  265.             (int)(object->size / object->type->size) );
  266.         Struct_ReleaseType(oldtype);
  267.         } else if (object->size > object->type->size) {
  268.         /* Shorter than before. Use the shorter size. */
  269.         object->size = object->type->size;
  270.         } else {
  271.         sprintf(errbuf,"type \"%s\" does not have compatible size", name2+1 );
  272.         return errbuf;
  273.         }
  274.         continue;
  275.     }
  276.  
  277.     /*  The component of the name may either be a numeric
  278.      *  offset into an array, or a named element of a
  279.      *  structure.
  280.      */
  281.     if (isdigit(name2[0]) || name2[0] == '-') {
  282.         int num;
  283.         int num2 = -1;
  284.         char *after;
  285.         Struct_TypeDef *oldtype;
  286.         if (!(object->type->flags & (STRUCT_FLAG_IS_ARRAY|STRUCT_FLAG_IS_POINTER))) {
  287.         sprintf(errbuf,"\"%s\" is not an array or pointer",
  288.             object->type->name );
  289.         return errbuf;
  290.         }
  291.         num = strtol( name2, &after, 10 );
  292.         if (*after == '-') {
  293.         /* A range. */
  294.         num2 = strtol( after+1, &after, 10 );
  295.         if (num2 != 0 && num2 <= num)
  296.             return "array indices are reversed";
  297.         }
  298.         if (*after != '\0') {
  299.         sprintf(errbuf,"invalid array index \"%s\"", name2 );
  300.         return errbuf;
  301.         }
  302.         if (object->type->flags & STRUCT_FLAG_IS_ARRAY) {
  303.             int nelem = object->size / object->type->u.a.array_elem->size;
  304.         if ( (num < 0) ||
  305.              ((num >= nelem) &&
  306.               (object->type->flags & STRUCT_FLAG_STRICT)) )
  307.             return "array index is out of range";
  308.         if ( (num2 > 0) && (num2 >= nelem) &&
  309.              (object->type->flags & STRUCT_FLAG_STRICT) )
  310.             return "array index is out of range";
  311.         } else if (object->type->flags & STRUCT_FLAG_STRICT) {
  312.         if (num != 0)
  313.             return "using non-zero index on pointer";
  314.         if (num2 > 0)
  315.             return "using non-zero index on pointer";
  316.         }
  317.         oldtype = object->type;
  318.         if (object->type->flags & (STRUCT_FLAG_IS_POINTER)) {
  319.         /* Convert Pointer to array.  Do it so as to avoid
  320.          * a bus error for misalignment. */
  321.         void *v;
  322.         memcpy( (char *)&v, object->data, sizeof(v) );
  323.         if (v == NULL)
  324.            return "trying to dereference a NULL pointer";
  325.         object->data = v;
  326.         }
  327.         if (num2 >= 0) {
  328.         ClientData cdata;
  329.         if ((cdata = Struct_GetClientData(interp)) == NULL)
  330.             return "No access to type table";
  331.         /* Create array */
  332.         if (num2 == 0)
  333.             num2 = object->size / object->type->u.a.array_elem->size;
  334.         object->type = Struct_DefArray( cdata, interp,
  335.             object->type->u.a.array_elem,
  336.             num2 - num );
  337.         /* Struct_AttachType(object->type); attached by DefArray */
  338.         Struct_ReleaseType(oldtype);
  339.         object->size = object->type->size;
  340.         object->data = ((char *)object->data) + num * object->type->u.a.array_elem->size;
  341.         } else {
  342.         /* Point it at single object */
  343.         object->type = object->type->u.a.array_elem;
  344.         Struct_AttachType(object->type);
  345.         Struct_ReleaseType(oldtype);
  346.         object->size = object->type->size;
  347.         object->data = ((char *)object->data) + num * object->size;
  348.         }
  349.         continue;
  350.     }
  351.  
  352.     /*  At this point we have either a named element, or an empty
  353.      *  name.  In the interest of expediency we will automatically
  354.      *  do a single level of pointer dereferencing.
  355.      */
  356.     if (object->type->flags & (STRUCT_FLAG_IS_POINTER)) {
  357.         Struct_TypeDef *oldtype;
  358.         void *v;
  359.         memcpy( (char *)&v, object->data, sizeof(v) );
  360.         if (v == NULL)
  361.            return "trying to dereference a NULL pointer";
  362.         oldtype = object->type;
  363.         object->type = object->type->u.a.array_elem;
  364.         Struct_AttachType(object->type);
  365.         Struct_ReleaseType(oldtype);
  366.         object->data = v;
  367.         object->size = object->type->size;
  368.         if (name2[0] == '\0')
  369.         continue;    /* Explicit dereference */
  370.     }
  371.  
  372.     /*  This must be a named element of a structure.
  373.      */
  374.     if (!(object->type->flags & STRUCT_FLAG_IS_STRUCT)) {
  375.         sprintf(errbuf, "\"%s\" is not a struct", object->type->name );
  376.         return errbuf;
  377.     }
  378.     /*  Look up the name.  */
  379.     for ( pelem = object->type->u.s.struct_def;
  380.           pelem->name == NULL || strcmp(pelem->name,name2) != 0;
  381.           pelem++ ) {
  382.         if (pelem->type == NULL) {
  383.         sprintf(errbuf, "\"%s\" is not a member", name2 );
  384.         return errbuf;
  385.         }
  386.     }
  387.     object->data = (char *)object->data + pelem->offset;
  388.     Struct_AttachType(pelem->type);
  389.     Struct_ReleaseType(object->type);
  390.     object->type = pelem->type;
  391.     object->size = object->type->size;
  392.     }
  393. #ifdef DEBUG
  394.     if (struct_debug & (DBG_PARSEELEMENT))
  395.     printf("Struct_AccessElement() = %s\n", Struct_ObjectName(object,0) );
  396. #endif
  397.     return NULL; /*OKAY*/
  398. }
  399.